Add function WinOpenURL, which works with anchors.
authoroliskoli <oliskoli@f51c46e8-681c-474f-0cfe-069cfd0219fb>
Thu, 13 Apr 2006 07:02:04 +0000 (07:02 +0000)
committeroliskoli <oliskoli@f51c46e8-681c-474f-0cfe-069cfd0219fb>
Thu, 13 Apr 2006 07:02:04 +0000 (07:02 +0000)
gpsbabel/win32/gui-2/utils.pas

index 62b491dc318c79c65dcd89cc0d6c29d481417967..2f8162db92b5d92cec3d237d198726183b2afaaf 100644 (file)
@@ -44,13 +44,16 @@ procedure RestoreProperties(Instance: TObject; Backup: TStringList);
 \r
 procedure FixStaticText(AComponent: TComponent);\r
 \r
-procedure WinOpenFile(const Name: string);\r
+function WinOpenFile(const AFile, AParams: string): Boolean;\r
+procedure WinOpenURL(const AURL: string);\r
 \r
 procedure UniWrite(Target: TStream; const Str: WideString);\r
 procedure UniWriteLn(Target: TStream; const Str: WideString);\r
 \r
 procedure MakeFirstTranslation(AComponent: TComponent);\r
 \r
+function readme_html_path: string;\r
+\r
 implementation\r
 \r
 uses\r
@@ -88,6 +91,7 @@ var
   Error: DWORD;\r
   Wait_Result: DWORD;\r
   s: string;\r
+  i: Integer;\r
 \r
 begin\r
   Result := False;\r
@@ -146,7 +150,9 @@ begin
         if (BytesRead > 0) then Application.ProcessMessages;\r
         while (BytesRead > 0) do\r
         begin\r
-          ReadFile(hRead, buffer^, BUFFER_SIZE - 1, BytesDone, nil);\r
+          BytesDone := BytesRead;\r
+          if (BytesDone > (BUFFER_SIZE - 1)) then BytesDone := BUFFER_SIZE - 1;\r
+          ReadFile(hRead, buffer^, BytesDone, BytesDone, nil);\r
           if (BytesDone > 0) then\r
           begin\r
             buffer[BytesDone] := #0;\r
@@ -165,6 +171,12 @@ begin
       raise eGPSBabelError.CreateFmt(_('"gpsbabel.exe" returned error 0x%x (%d)'), [Error, Error]);\r
 \r
     Output.Clear;\r
+    while True do\r
+    begin\r
+      i := Pos(#13#13, s);\r
+      if (i <> 0) then System.Delete(s, i, 1)\r
+      else break;\r
+    end;\r
     Output.SetText(PChar(s));\r
 \r
     Result := True;\r
@@ -266,9 +278,79 @@ begin
   end;\r
 end;\r
 \r
-procedure WinOpenFile(const Name: string);\r
+function WinOpenFile(const AFile, AParams: string): Boolean;\r
+var\r
+  p: PChar;\r
+begin\r
+  if (AParams = '') then\r
+    p := nil else\r
+    p := PChar(AParams);\r
+  Result := (ShellExecute(0, 'open', PChar(AFile), p, nil, SW_SHOW) > 32);\r
+end;\r
+\r
+procedure WinOpenURL(const AURL: string);\r
+var\r
+  i: Integer;\r
+  reg: TRegistry;\r
+  cmd: string;\r
+  prg: string;\r
+  url: string;\r
 begin\r
-  ShellExecute(0, 'open', PChar(Name), nil, '', 0);\r
+  url := AURL;\r
+  reg := TRegistry.Create;\r
+  try\r
+    reg.RootKey := HKEY_LOCAL_MACHINE;\r
+    if reg.OpenKeyReadOnly('Software\Classes\HTTP\Shell\Open\Command') then\r
+    begin\r
+      prg := reg.ReadString('');\r
+      if (prg <> '') then\r
+      begin\r
+        i := Pos('%1', prg);\r
+        if (i <> 0) then\r
+        begin\r
+          System.Delete(prg, i, 2);\r
+          System.Insert(url, prg, i);\r
+          url := '';\r
+        end;\r
+\r
+        if (prg[1] = '"') then\r
+        begin\r
+          i := Pos('"', Copy(prg, 2, Length(prg)));\r
+          if (i = 0) then Exit;\r
+          cmd := Copy(prg, 2, i - 1);\r
+          Delete(prg, 1, i + 1);\r
+          prg := Trim(prg);\r
+          if (url <> '') then\r
+          begin\r
+            if (prg = '') then\r
+              prg := URL else\r
+              prg := prg + ' ' + URL;\r
+          end;\r
+          if WinOpenFile(cmd, PChar(prg)) then Exit\r
+        end\r
+          else\r
+        if (Pos(' ', prg) <> 0) then\r
+        begin\r
+          i := Pos(' ', prg);\r
+          cmd := Trim(Copy(prg, 1, i - 1));\r
+          prg := Trim(Copy(prg, i + 1, Length(prg)));\r
+          if (url <> '') then\r
+          begin\r
+            if (prg = '') then\r
+              prg := URL\r
+            else\r
+              prg := Trim(prg) + ' ' + URL;\r
+          end;\r
+          if WinOpenFile(cmd, PChar(prg)) then Exit;\r
+        end\r
+        else\r
+          if WinOpenFile(prg, PChar(URL)) then Exit;\r
+      end;\r
+    end;\r
+  finally\r
+    reg.Free;\r
+  end;\r
+  WinOpenFile(AURL, '');\r
 end;\r
 \r
 procedure UniWrite(Target: TStream; const Str: WideString);\r
@@ -305,6 +387,19 @@ begin
 // !!! TRICK !!!\r
 end;\r
 \r
+function readme_html_path: string;\r
+begin\r
+  Result := ExtractFilePath(ParamStr(0)) + 'readme.html';\r
+  if FileExists(Result) then\r
+  begin\r
+    while (Pos('\', Result) <> 0) do\r
+      Result[Pos('\', Result)] := '/';\r
+    Result := 'file:///' + Result;\r
+  end\r
+  else\r
+    Result := SGPSBabelURL + '/readme.html';\r
+end;\r
+\r
 var\r
   hMutex: THandle;\r
   \r